home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok31.lha / mcd / mcd.mod < prev    next >
Text File  |  1993-08-15  |  11KB  |  353 lines
  1. (********************************************************************
  2.   :Program.       mcd.mod
  3.   :Author.        Ludwig Geromiller
  4.   :Address.       Filderstr. 63, 7000 Stuttgart 1
  5.   :Phone.         0711/6409664
  6.   :History.       V2.0, Nov-89, Ludwig Geromiller
  7.   :Copyright.     PD
  8.   :Language.      Modula-II
  9.   :Translator.    M2Amiga 3.2d
  10.   :Imports.       Nix
  11.   :Contents.      My cd: ermöglicht Directorywechsel mit Wildcards
  12.   :Contents.      und ohne Angabe des gesamten Pfadnamens
  13.   :Contents.      Funktion ähnlich wie Norton-cd auf IBM-PC`s
  14.   :Usage.         Aufruf aus CLI: z.B. mcd Diam#? oder mcd Diamo*
  15.   :Usage.         (springt direkt ins Verzeichnis :fonts/Diamond)
  16.   :Remark.        Die Datei :Tree.mcd enthält die Directorystruktur und
  17.   :Remark.        wird mittels mcdTree >:Tree.mcd angelegt
  18.   :Remark.        (s.a. mcdTree.mod)
  19. ********************************************************************)
  20.  
  21. MODULE mcd;
  22.  
  23. FROM Arguments  IMPORT NumArgs, GetArg;
  24. FROM Arts       IMPORT Assert, TermProcedure, Terminate;
  25. FROM ASCII      IMPORT csi, cr;
  26. FROM Str        IMPORT Length, Concat, Compare,CapString,
  27.                        CopyPos, FirstPos, noOccur;
  28. FROM Strings    IMPORT Occurs, first, last, Delete, Insert;
  29. FROM SYSTEM     IMPORT ADDRESS, ADR, CAST, BPTR;
  30. FROM Terminal   IMPORT Write, WriteString, WriteLn;
  31. FROM InOut      IMPORT WriteInt, WriteCard;
  32. FROM Dos        IMPORT BSTR, FileInfoBlock, FileInfoBlockPtr, UnLock,
  33.                        FileLock, CurrentDir, FileHandlePtr, Execute,
  34.                        FileLockPtr, sharedLock, Lock, Examine, ExNext,
  35.                        ProcessPtr;
  36. FROM Exec       IMPORT AllocMem, FreeMem, MemReqs, MemReqSet, Task,
  37.                        TaskPtr, FindTask;
  38. IMPORT Dos;
  39. IMPORT FileSystem;
  40.  
  41. TYPE String     = ARRAY [0..107] OF CHAR;
  42.      Position = (front,back,both);
  43.      Entry = RECORD
  44.                 Level   : CARDINAL;
  45.                 Dirname : String;
  46.              END; (* RECORD *)
  47. VAR Match : PROCEDURE(ARRAY OF CHAR):BOOLEAN;
  48.         (* globale Prozedurvariable
  49.                 falls kein Muster -> Match := Equal
  50.                 falls Muster      -> Match := Pattern
  51.         *)
  52.     newDir, argDir, oldDir : String;
  53.     argnumber,arglength    : INTEGER;
  54.     oldcdptr, newcdptr     : FileLockPtr;
  55.     erfolg, found, root    : BOOLEAN;
  56.     erf                    : LONGINT;
  57.     deleteLine             : ARRAY [0..2] OF CHAR;
  58.        (* Steuerzeichen für Console *)
  59.     patpos                 : Position;
  60.     ProcPtr                : ProcessPtr;
  61.     taskPtr                : TaskPtr;
  62.     i, oldLevel            : CARDINAL;
  63.     laenge, anz, Startadr,
  64.     Index, merk            : LONGINT;
  65.     file                   : FileSystem.File;
  66.     HandlePtr              : FileHandlePtr;
  67.     altdir, neudir         : Entry;
  68.     chrPtr                 : POINTER TO CHAR;
  69.     Zeichen                : CHAR;
  70.  
  71.  
  72. PROCEDURE Ausstieg;
  73.   BEGIN
  74.     IF (Startadr#NIL) THEN
  75.       FreeMem(Startadr,laenge);
  76.       Startadr:=NIL
  77.     END; (* IF *)
  78.     Write(csi);WriteString(" p");
  79.   END Ausstieg;
  80.  
  81. PROCEDURE SetNewCD (newDir:ARRAY OF CHAR);
  82. BEGIN
  83.   newcdptr:=Lock(ADR(newDir), sharedLock);
  84.   oldcdptr := CurrentDir (newcdptr);
  85.   IF newcdptr # NIL THEN
  86.     IF oldcdptr # NIL THEN
  87.       UnLock (oldcdptr);
  88.       found:=TRUE
  89.     END; (* IF *)
  90.     i:=0;
  91.     REPEAT
  92.       INC(i);
  93.       ProcPtr^.cli^.setName^[i] := newDir[i-1];
  94.     UNTIL newDir[i]=0C;
  95.     ProcPtr^.cli^.setName^[0] := CHAR(i);
  96.   END; (* IF *)
  97. END SetNewCD;
  98.  
  99. PROCEDURE BSTRtoString(bstr:BSTR; VAR string: ARRAY OF CHAR);
  100.   VAR aptr   : POINTER TO String;
  101.       counter: CARDINAL;
  102.   BEGIN
  103.     aptr := ADDRESS(CAST(BPTR,bstr));
  104.     IF CARDINAL(aptr^[0]) = 0 THEN
  105.       string:="";
  106.       RETURN
  107.     END; (* IF *)
  108.     FOR counter:=0 TO CARDINAL(aptr^[0])-1 DO
  109.       string[counter]:=aptr^[counter+1]
  110.     END; (* FOR *)
  111.     string[ORD(aptr^[0])] := 0C
  112.   END BSTRtoString;
  113.  
  114. PROCEDURE Equal(string:ARRAY OF CHAR):BOOLEAN;
  115.   BEGIN
  116.     CapString(string);
  117.     IF Compare(string,argDir)=0 THEN
  118.       RETURN TRUE
  119.     ELSE
  120.       RETURN FALSE
  121.     END (* IF *)
  122.   END Equal;
  123.  
  124. PROCEDURE Pattern(string:ARRAY OF CHAR):BOOLEAN;
  125.     VAR pos :INTEGER;
  126.   BEGIN
  127.     CapString(string);
  128.     pos := Occurs(string,0,argDir,FALSE);
  129.     IF pos # last THEN
  130.       CASE patpos OF
  131.         both  : RETURN TRUE |
  132.         front : IF CARDINAL(pos) = Length(string)-Length(argDir) THEN
  133.                   RETURN TRUE
  134.                 ELSE
  135.                   RETURN FALSE
  136.                 END|
  137.         back  : IF pos = 0 THEN
  138.                   RETURN TRUE
  139.                 ELSE
  140.                   RETURN FALSE
  141.                 END
  142.       END; (* CASE *)
  143.     ELSE
  144.       RETURN FALSE
  145.     END (* IF *)
  146.   END Pattern;
  147.  
  148. PROCEDURE ReadTree();
  149.   BEGIN (* ReadTree *)
  150.     FileSystem.Lookup(file,":Tree.mcd",0,FALSE);
  151.     IF file.res=FileSystem.notFound THEN (*Datei :Tree.mcd nicht gefunden*)
  152.       WriteString("Plattenanalyse! Please Wait.....");WriteLn;
  153.       HandlePtr := Dos.Open(ADR(":Tree.mcd"),Dos.newFile);
  154.       erf:=Execute(ADR("mcdTree"),NIL,HandlePtr);
  155.     (* mcdtree>:Tree.mcd *)
  156.       Dos.Close(HandlePtr);
  157.       FileSystem.Lookup(file,":Tree.mcd",0,FALSE);
  158.     END; (* IF *)
  159.     FileSystem.Length (file,laenge);
  160.     FileSystem.Close(file);
  161.     Startadr := LONGINT(AllocMem(laenge,MemReqSet{chip}));
  162.     Assert(Startadr#NIL,ADR("zu wenig Speicher"));
  163.     HandlePtr := Dos.Open(ADR(":Tree.mcd"),1005);
  164.     anz := Dos.Read(HandlePtr,Startadr,laenge);
  165.     Assert(anz=laenge,ADR("Fehler beim Lesen"));
  166.     Dos.Close(HandlePtr);
  167.     Index := Startadr;
  168.   END ReadTree;
  169.  
  170. PROCEDURE ReadEntry(VAR entry: Entry; VAR Index:LONGINT);
  171.  (* Liefert Entry an der Stelle Index *)
  172.   BEGIN
  173.     INC(Index);
  174.     Assert(Index<=Startadr+laenge,ADR("ReadEntry Index zu hoch!"));
  175.     chrPtr:=ADDRESS(Index);
  176.     entry.Level := CARDINAL(chrPtr^)-48;
  177.  
  178.     INC(Index,3);
  179.     chrPtr:=ADDRESS(Index);
  180.     i:=0;
  181.     REPEAT
  182.       entry.Dirname[i]:=chrPtr^;
  183.       INC(i);INC(Index);
  184.       Assert(Index<=Startadr+laenge,ADR("ReadEntry Index zu hoch!"));
  185.       chrPtr:=ADDRESS(Index);
  186.     UNTIL chrPtr^=12C;
  187.     entry.Dirname[i]:=0C;
  188.     INC(Index);
  189.   END ReadEntry;
  190.  
  191. PROCEDURE Backspace(VAR Index:LONGINT); (* setzt Index um einen Entry zurück *)
  192.   BEGIN
  193.     DEC(Index,4);
  194.     REPEAT
  195.       DEC(Index);
  196.       Assert(Index>=Startadr,ADR("Backspace Index zu klein!"));
  197.       chrPtr:=ADDRESS(Index);
  198.     UNTIL(chrPtr^=12C); (* REPEAT *)
  199.     INC(Index);
  200.   END Backspace;
  201.  
  202. PROCEDURE altDir();  (* Liefert Index merk vom alten Dir in Tree.mcd *)
  203.   VAR pos,start: INTEGER;
  204.       lastCh   : CHAR;
  205.   BEGIN
  206.     Index := Startadr; (* init *)
  207.     merk:= Startadr;
  208.     pos :=0; start:=0;
  209.     LOOP
  210.       REPEAT
  211.         ReadEntry(altdir,Index);
  212.         WriteString(altdir.Dirname); WriteString(deleteLine);
  213.         pos := Occurs(oldDir,start,altdir.Dirname,TRUE);
  214.         lastCh := oldDir[start+INTEGER(Length(altdir.Dirname))];
  215.         IF (Index>=Startadr+laenge-1) THEN (* Fileende Tree.mcd *)
  216.           IF (CARDINAL(start)<Length(oldDir)) THEN
  217.             WriteString("Aktuelles Directory nicht in Tree.mcd gefunden!");WriteLn;
  218.             WriteString("Jetzt kommt Directoryscan for Tree.mcd mittels mcdTree");
  219.             WriteLn; WriteString("Bitte warten..."); WriteLn;
  220.             HandlePtr := Dos.Open(ADR(":Tree.mcd"),Dos.newFile);
  221.             erf:=Execute(ADR("mcdTree"),NIL,HandlePtr);
  222.           (* mcdtree>:Tree.mcd *)
  223.             Dos.Close(HandlePtr); Ausstieg;
  224.             ReadTree; altDir; EXIT;
  225.             HALT;
  226.           ELSE
  227.             EXIT
  228.           END; (* IF *)
  229.         END; (* IF *)
  230.       UNTIL (pos=start) AND ((lastCh=0C)OR(lastCh=":")OR(lastCh="/"));
  231.             (* bis vollständ. Name gefunden *)
  232.       start:= pos+INTEGER(Length(altdir.Dirname))+1; (* 1 wegen :,/ *)
  233.       IF CARDINAL(start)>=Length(oldDir) THEN
  234.         merk := Index; (* ab hier wird nach neuem Directory gesucht *)
  235.         EXIT
  236.       END; (* IF *)
  237.     END; (* LOOP *)
  238.   END altDir;
  239.  
  240. PROCEDURE DirSearch(); (* scan for Index neues Dir *)
  241.   VAR entry:Entry;
  242.   BEGIN
  243.     WHILE NOT Match(neudir.Dirname) DO
  244.       ReadEntry(neudir,Index);
  245.       IF ((Index>Startadr+laenge-1) AND (anz=laenge)) THEN
  246.         Index:=Startadr;
  247.         INC(anz,laenge);
  248.       ELSIF ((anz>laenge) AND (merk<Index)) THEN
  249.         WriteString("Neues Directory nicht in Tree.mcd gefunden!"); WriteLn;
  250.         (* Hier kommt später eine Bewertung nach WLD
  251.                      (gewichtete Levenstein-Distanz) des Dir-namens *)
  252.         WriteLn; Terminate(10);
  253.       END; (* IF *)
  254.     END; (* WHILE *)
  255.     found    := TRUE;
  256.     merk     := Index;
  257.     newDir   := neudir.Dirname;
  258.     oldLevel := neudir.Level;
  259.     WHILE (oldLevel>1) DO
  260.       Insert(newDir,0,"/");
  261.       REPEAT
  262.         Backspace(Index); Backspace(Index);
  263.         ReadEntry(entry,Index);
  264.       UNTIL (entry.Level=oldLevel-1);
  265.       oldLevel := entry.Level;
  266.       Insert(newDir,0,entry.Dirname);
  267.     END; (* WHILE *)
  268.     WriteString("Changing to "); WriteString(newDir);WriteLn;
  269.     Insert(newDir,0,":");
  270.     Index:=Startadr;
  271.     ReadEntry(entry,Index);
  272.     Insert(newDir,0,entry.Dirname);
  273.     SetNewCD(newDir);
  274.   END DirSearch;
  275.  
  276. BEGIN (* mcd *)
  277.   TermProcedure(Ausstieg);
  278.   argnumber := NumArgs();
  279.   IF argnumber = 1 THEN
  280.     GetArg(1,argDir,arglength);
  281.     IF argDir[0] ="?" THEN
  282.       WriteString("Eingabe:  mcd [DIR]"); WriteLn;
  283.       WriteString(" - Muster für [DIR]: ");
  284.       WriteString("[#?]Zeichenfolge[#?] oder [*]Zeichenfolge[*]");
  285.       WriteLn;
  286.       Terminate(0);
  287.     END; (* IF *)
  288.   ELSE
  289.     WriteString("Eingabe:  mcd [DIR]"); WriteLn;
  290.     WriteString(" - Muster für [DIR]: ");
  291.     WriteString("[#?]Zeichenfolge[#?] oder [*]Zeichenfolge[*]");
  292.     WriteLn;
  293.     Terminate(0);
  294.   END; (* IF *)
  295.  
  296. CapString(argDir);
  297.  
  298.   IF (Occurs(argDir,0,"#?",FALSE)=last) AND
  299.      (Occurs(argDir,0,"*",FALSE)=last) THEN
  300.     Match := Equal
  301.   ELSE
  302.     Match := Pattern;
  303.     patpos := back;
  304.  
  305.     IF FirstPos(argDir,0,"#")=0 THEN
  306.       Delete(argDir,0,2);
  307.       patpos := front
  308.     ELSIF FirstPos(argDir,0,"*")=0 THEN
  309.       Delete(argDir,0,1);
  310.       patpos := front
  311.     END; (* IF *)
  312.  
  313.     IF FirstPos(argDir,0,"#")= LONGINT(Length(argDir)-2) THEN
  314.       Delete(argDir,Length(argDir)-2,2);
  315.       IF patpos = front THEN
  316.         patpos := both
  317.       END (* IF *)
  318.     END; (* IF *)
  319.  
  320.     IF FirstPos(argDir,0,"*")= LONGINT(Length(argDir)-1) THEN
  321.       Delete(argDir,Length(argDir)-1,1);
  322.       IF patpos = front THEN
  323.         patpos := both
  324.       END (* IF *)
  325.     END; (* IF *)
  326.  
  327.   END; (* IF *)
  328.   Write(csi); WriteString("0 p"); (* Cursor Aus *)
  329.   Write(csi); WriteString("1;33;42m");
  330.   WriteString("My-cd V2.0 by ---- Gero-Soft ---- ");
  331.   Write(csi); WriteString("0;31;40m"); WriteLn;WriteLn;
  332.   deleteLine[0] := cr;
  333.   deleteLine[1] := csi;
  334.   deleteLine[2] := "K";
  335.  
  336.   taskPtr := FindTask(NIL);
  337.   ProcPtr := ADR(taskPtr^);
  338.   BSTRtoString(ProcPtr^.cli^.setName,oldDir);
  339.  
  340.   found := FALSE;
  341.   ReadTree;
  342.   altDir(); (* such ab Start nach altem Dir oldDir *)
  343.  
  344.   DirSearch(); (* such ab merk nach argDir; wenn Dateiende von vorn suchen *)
  345.  
  346.   IF NOT found THEN
  347.     WriteString("Es wurde kein zu `");
  348.     WriteString(argDir);
  349.     WriteString("` passender Eintrag gefunden!");
  350.     WriteLn
  351.   END (* IF *)
  352. END mcd.mod
  353.